home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0006_PLAYMUSC.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  84 lines
  1. { Here is a Unit that plays music. It came out of this echo recently. }
  2.  
  3.  
  4. Unit Music;
  5.  
  6. Interface
  7.  
  8. Uses
  9.   Crt;
  10. Const
  11.    e_note = 15;       { Eighth Note      }
  12.    q_note = 30;       { Quarter Note     }
  13.    h_note = 60;       { Half Note        }
  14.    dh_note = 90;      { Dotted Half Note }
  15.    w_note = 120;      { Whole Note       }
  16.    R = 0;             { Rest             }
  17.    C = 1;             { C                }
  18.    Cs = 2;            { C Sharp          }
  19.    Db = 2;            { D Flat           }
  20.    D = 3;             { D                }
  21.    Ds = 4;            { D Sharp          }
  22.    Eb = 4;            { E Flat           }
  23.    E = 5;             { Etc...           }
  24.    F = 6;
  25.    Fs = 7;
  26.    Gb = 7;
  27.    G = 8;
  28.    Gs = 9;
  29.    Ab = 9;
  30.    A = 10;
  31.    As = 11;
  32.    Bb = 11;
  33.    B = 12;
  34.  
  35. Procedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);
  36. Procedure ToneOn(Octave   : Byte; Note     : Byte);
  37.  
  38. Implementation
  39.  
  40. Var
  41.   Oct_Val  : Array [0..8] Of Real;
  42.   Freq_Val : Array [C..B] Of Real;
  43.  
  44. Procedure Set_Frequencies;
  45. Var
  46.   N : Byte;
  47. begin
  48.   Freq_Val[1] := 1;
  49.   For N := 2 To 12 Do
  50.     Freq_Val[N] := Freq_Val[N-1] * 1.0594630944;
  51.   Oct_Val[0] := 32.70319566;
  52.   For N := 1 To 8 Do
  53.     Oct_Val[N] := Oct_Val[N-1] * 2;
  54. end;
  55.  
  56. Procedure PlayTone(Octave : Byte; Note : Byte; Duration : Word);
  57. begin
  58.   If Note = R Then
  59.     NoSound
  60.   Else
  61.     Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));
  62.   Delay(Duration*8);
  63.   NoSound;
  64. end;
  65.  
  66. Procedure ToneOn(Octave : Byte; Note : Byte);
  67. begin
  68.   If Note = R Then
  69.     NoSound
  70.   Else
  71.     Sound(Round(Oct_Val[Octave] * Freq_Val[Note]));
  72. end;
  73.  
  74. begin
  75.   Set_Frequencies;
  76.   NoSound;
  77. end.
  78.  
  79. {
  80.   This does not include the actual values of the tones, but it is still
  81. very helpful (more so than if you had the actual freqencies). If you still
  82. want the tones, just substitute the value For the tone into the Procedures
  83. that play the tone.
  84. }